home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / halcn305.zip / TESTFRM2.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-29  |  3KB  |  105 lines
  1. program TestFrm2;
  2. {------------------------------------------------------------------------------
  3.                                 Formula Routine
  4.                                 Demo Program 1
  5.  
  6.        TESTFRM2.PAS Copyright (c)  Richard F. Griffin
  7.  
  8.        27 July 1993
  9.  
  10.        102 Molded Stone Pl
  11.        Warner Robins, GA  31088
  12.  
  13.        -------------------------------------------------------------
  14.  
  15.        The Formula routine in HALCYON only handles straight field names.
  16.        However, the power of using objects is how simple it becomes to
  17.        modifiy an ancestor object.  The following code, taken from demo
  18.        program GSDMO_06.PAS, shows creating a child object with a virtual
  19.        method Formula.  This method will be called anytime a formula is
  20.        needed for an index action from anywhere within the ancestor
  21.        object(s).
  22.  
  23.        In this example, substrings of the first five positions of the
  24.        LASTNAME and FIRSTNAME fields are combined in a string that is
  25.        then returned as the formula's result.
  26.  
  27.        The IndexOn command must contain the correct formula; for example:
  28.        IndexOn('DEMOFRM2','SUBSTR(LASTNAME,1,5)+SUBSTR(FIRSTNAME,1,5)');
  29.        so it will be stored properly in the index header for use by other
  30.        programs such as dBase, FoxPro, Clipper, etc.
  31.  
  32. -------------------------------------------------------------------------------}
  33.  
  34. uses
  35.    GSOB_DBS,
  36.    GSOB_Str,
  37.    GSOBShel,
  38.    {$IFDEF WINDOWS}
  39.       WinCRT,
  40.       WinDOS;
  41.    {$ELSE}
  42.       CRT,
  43.       DOS;
  44.    {$ENDIF}
  45.  
  46. {----------------------------------------------------------------------------}
  47. {$F+}
  48. Function UFormula(st: string; var fmrec: GSR_FormRec): boolean;
  49. var FldCnt : integer;
  50. begin
  51.    if (fmrec.FAlias = 'TESTFRM2') then  {Correct Index?}
  52.    begin                                       {Then set extract table}
  53.       UFormula := true;
  54.       for FldCnt := 0 to 32 do fmrec.FPosn[FldCnt] := 0;
  55.       fmrec.FType := 'C';
  56.       fmrec.FDcml := 0;
  57.       fmrec.FSize := 10;    {5 chars from LASTNAME and FIRSTNAME}
  58.    end
  59.    else UFormula := true;
  60. end;
  61.  
  62. Function UFormXtract(var st: string; fmrec: GSR_FormRec): boolean;
  63. begin
  64.    if (fmrec.FAlias = 'TESTFRM2') then    {Correct index?}
  65.    begin
  66.       UFormXtract := true;
  67.       st := SubStr(FieldGet('LASTNAME'),1,5) +
  68.             SubStr(FieldGet('FIRSTNAME'),1,5);
  69.    end
  70.    else UFormXtract := false;
  71. end;
  72. {$F-}
  73. {----------------------------------------------------------------------------}
  74.  
  75. begin
  76.    ClrScr;
  77.    if not FileExist('GSDMO_01.DBF') then
  78.    begin
  79.       writeln('File GSDMO_01.DBF not found.  Run GSDMO_01 to create.');
  80.       halt;
  81.    end;
  82.  
  83.    Select(1);
  84.    Use('GSDMO_01');
  85.    SetFormulaProcess(UFormula, UFormXtract);
  86.    IndexOn('TESTFRM2','SUBSTR(LASTNAME,1,5) + SUBSTR(FIRSTNAME,1,5)');
  87.                            {formula is stored in index header}
  88.    GoTop;
  89.    while not dEOF do
  90.    begin
  91.       writeln(FieldGet('LASTNAME'),' ',
  92.               FieldGet('FIRSTNAME'));
  93.       Skip(1);
  94.    end;
  95.    SetFormulaProcess(DefFormulaBuild, DefFormulaXtract);
  96.    CloseDataBases;
  97.    write('Press any Key to continue:');
  98.    repeat until KeyPressed;
  99. end.
  100.  
  101. -----------------------------------------------------------------------------
  102.                                      END
  103.  
  104.  
  105.